let sdl_init () =
  begin
    Sdl.init [`EVERYTHING];
    Sdlevent.enable_events Sdlevent.all_events_mask;
  end

let get_dims img =
  ((Sdlvideo.surface_info img).Sdlvideo.w, (Sdlvideo.surface_info
  img).Sdlvideo.h)

(*maillage *)
let maillage img frequency =
 let (width, height) = get_dims img in
   for y = 0 to (height - 1) do
     for x = 0 to (width - 1) do 
 (* horizontal and vertical lines *)   
       if(y mod frequency = 0)||(x mod frequency = 0)then 
	 Sdlvideo.put_pixel_color img x y (0,0,0);
 (* diagonal lines *)
       if x mod frequency = y mod frequency  then
         Sdlvideo.put_pixel_color img x y (0,0,0); 
    (* color the intersections of the lines *)
       if x mod frequency = 0 && y mod frequency = 0 then
	 begin
           Sdlvideo.put_pixel_color img x y (255,255,55);
	 end 
     done;
   done;
   (* line at the bottom of the picture *) 
   for x = 0 to width - 1 do
     Sdlvideo.put_pixel_color img x (height-1) (0,0,0)
   done;
   (* color the intersection at the bottom of the picture *) 
   for x = 0 to (width / frequency)  do
     Sdlvideo.put_pixel_color img (x*frequency) (height-1) (255,255,55)
   done;
   (* line on the right of the picture *) 
   for y = 0 to height do
     Sdlvideo.put_pixel_color img (width-1) y (0,0,0)
   done;
   (* color the intersection on the right of the picture *)
   for y =0 to (height/frequency)  do
     Sdlvideo.put_pixel_color img (width-1) (y*frequency) (255,255,55)
   done 



let comprgb (r1,g1,b1) (r2,g2,b2) =
  ((r1 = r2)&&(g1 = g2)&&(b1 = b2))||((r2=0)&&(g2 = r2)&&(b2 = r2))
	
let rec colorexist l color = match l with
  | [] -> false
  | e::r -> (comprgb e color)||(colorexist r color)
	
let countcolor image nb colorlist =
  let (w, h) = get_dims(image) in
  let currentcolor = ref (0, 0, 0) in
    for i = 0 to (w - 1) do
      for j = 0 to (h - 1) do
	currentcolor := (Sdlvideo.get_pixel_color image i j);
	if ((colorexist (!colorlist) (!currentcolor))) then
	  begin
	    nb := !nb + 1;
	    colorlist := (!currentcolor) :: (!colorlist);
	  end
      done
    done
      
let point_to_tab x y z tab =
  let file = open_out_gen [Open_append;Open_creat]0o777 "coord" in
    begin
      output_string file (string_of_int(x) ^ "/" ^ string_of_int(y) ^ "/" ^
		     string_of_int(z) ^ "/" ^ "$");
   
      (x, y, z)::tab
    end

let parse_uptodown img =
  let (width, height) = get_dims img in
    for x = 0 to (width - 1) do
      for y = 0 to (height - 1) do
	if not (comprgb (Sdlvideo.get_pixel_color img x y)
	      (Sdlvideo.get_pixel_color img x (y+1))) then
	  Sdlvideo.put_pixel_color img x y (0, 0, 0)
      done
    done

let parse_lefttoright img =
  let (width, height) = get_dims img in
    for y = 0 to (height - 1) do
      for x = 0 to (width - 1) do
	if not (comprgb (Sdlvideo.get_pixel_color img x y)
		  (Sdlvideo.get_pixel_color img (x + 1)y)) then
	  Sdlvideo.put_pixel_color img x y (0, 0, 0)
      done
    done

let element_to_string color=
  let (r, g, b) = color in
    ( "(" ^ (string_of_int(r)) ^ ", " ^ (string_of_int(g)) ^ ", " ^
  (string_of_int(b)) ^ ")")

let rec aux_write file = function
  |[] -> ""
  |e::l -> (element_to_string e) ^ (aux_write file l)

let write image file_name =
  let l = ref [] in
  let nb = ref 0 in  
    countcolor image nb l;
    let str = string_of_int (!nb) in
    let file = open_out_gen [Open_append;Open_creat]0o777 file_name in
      begin
	output_string file (str ^ "\n" ^ aux_write file (!l));
	close_out file;
      end
   
let show img dst =
  let d = Sdlvideo.display_format img in
    Sdlvideo.blit_surface d dst ();
    Sdlvideo.flip dst

let rec wait_key () =
  let e = Sdlevent.wait_event () in
    match e with
    Sdlevent.KEYDOWN _ -> ()
      | _ -> wait_key ()


let main () =
  begin
    (* Initialisation de SDL *)
    sdl_init ();
    (* Chargement d'une image *)
    let img = Sdlloader.load_image Sys.argv.(1) in
      (* On récupère les dimensions *)
    let (w,h) = get_dims img in
      (* On crée la surface d'affichage en doublebuffering *)
    let display = Sdlvideo.set_video_mode w h [`DOUBLEBUF] in
      (* on affiche l'image *)
      show img display;
      wait_key ();
      write img "result";
      parse_uptodown img;
      parse_lefttoright img;
      
      show img display;
      wait_key ();
      Sdlvideo.save_BMP img "resultat.bmp";
    exit 0
  end
 
let _ = main ()
